COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	IFCR NOT DECLARATION($$PRGID) THENC 
C00003 00003	! scanning routines
C00005 00004	! pop,mty, push devstack
C00007 00005	! expandmacro
C00010 00006	! parse: number,nums,GTOKEN,namefile 
C00020 00007	!	_read procedures
C00024 00008	! input from different sources 
C00028 ENDMK
C⊗;
IFCR NOT DECLARATION($$PRGID) THENC 
ENTRY;
BEGIN "SCANNER"		 ENDC
DEFINE $SCANNER = TRUE ;

REQUIRE "HEADER.SAI" SOURCE_FILE;

! scanning routines;

SIMPLE STRING PROCEDURE SSCAN(REFERENCE STRING SOURCE; INTEGER BRK; REFERENCE INTEGER BRCHR);
BEGIN
	STRING S1,SS;
	INTEGER L;
	S1←SOURCE;
	SS←SCAN(SOURCE,BRK,BRCHR);
	IF (L←LENGTH(S1)-LENGTH(SOURCE))>0 THEN
		$CLNSAVE←$CLNSAVE&S1[1 TO L];
	RETURN(SS);
END;

SIMPLE STRING PROCEDURE SINTSCAN(REFERENCE STRING SOURCE;REFERENCE INTEGER BRCHR);
BEGIN
	STRING S1,SS;
	INTEGER L,V;
	S1←SOURCE;
	V←INTSCAN(SOURCE,BRCHR);
	IF (L←LENGTH(S1)-LENGTH(SOURCE))>0 THEN
		SS←S1[1 TO L]
		ELSE ERROR("SCANNER ERROR in SINTSCAN");
	$CLNSAVE←$CLNSAVE&SS;
	RETURN(SS);
END;

SIMPLE STRING PROCEDURE SREALSCAN(REFERENCE STRING SOURCE;REFERENCE INTEGER BRCHR);
BEGIN
	STRING S1,SS;
	INTEGER L;
	REAL R;
	S1←SOURCE;
	R←REALSCAN(SOURCE,BRCHR);
	IF (L←LENGTH(S1)-LENGTH(SOURCE))>0 THEN
		SS←S1[1 TO L]
		ELSE ERROR("SCANNER ERROR in SREALSCAN");
	$CLNSAVE←$CLNSAVE&SS;
	RETURN(SS);
END;
! pop,mty, push devstack;
RCLASS DEVSTACK(INTEGER DEV,DSKCHN; STRING $CLNE,$CLINR,$CRBODY;
		RPTR(DEVSTACK)NEXT);
RPTR(DEVSTACK) DEVSTACKTOP;

STRING $CRBODY;

INTERNAL PROCEDURE POPDEVSTACK;
BEGIN
	IF DEVSTACKTOP=NULL_RECORD THEN ERROR("cant pop devic`αPπ≠Sπ∂Zaβπ3⊗+π∪eεQβ␈#S?5∩Il4(LJ→α∩-2&∞∃l"N,bBαR"⊗r↓αJ⊗d*εN∃B"&:B≤A%l4PJ∩⊗ZL~⊗}∩-2NRε≤Yj∩⊗5Z∩⊗Z≥"ε∞.$zBulhP&&→∧"⊗Z&≤)v∩NYBaαRD*9α
,:&9↓$J:B∞Ez∩⊗Z≥"ε∞-T"N.∞Drn∩⊗5~Rε∞]">BuZ↓∩⊗>5z~ε2≤)mα⊗t!l4(J"∞2:-z∩⊗Z≥"ε∞-R"∞2:-Z∩⊗Z≥"ε∞.$zBulhP%∩∞dJ:J}$*ZNR~-i∩≤b&:J\"⊗ZN$
∞.R⎇αul4PI∩∞J∀z∩f}$*ZNR~-i∩≥∩
>∩MZ∩⊗Z≥"ε∞.$zBulhP&∩⊗5~Rε∞]">B}$*ZNR~-j:-BRn∩-2NRε≤ZR>BkX4*⊗t!l4(hR&:R-∩:ε1¬αJ>∞,"VJ∃∧jRf∩-2NRε≤Yl4*∀*≡&8L∩>>2,
9α~d
≥mα≥"J&::αMl4PJ↑"&d)α∩⊗5~Rε∞]">@nu*20b∀*∞>J"α∩=α∧zB∩⊗5~Rε∞[X4(&$yαN}Lr∞"NbB~2ε:IαV:$J1α~d
≥vR∃*∃l%
α∞2⊗
∩MαRMα⊗ε",
⊃↓lhP%∩∞dr⊗⎇∩≤b&:Jz"∞J
|"f}:,b1l4PJ∩⊗ZL~⊗}R%HbalhR⊗:⊃Xh(4*LrR⊗Jt
1αB∀z∞⊗∩-∩∃αB-~"∩⊗5~Rε∞[X4*
,:&84PJJBR∩B∩⊗Z≥"ε∞-Jα⊃ElhP&⊃F|r⊗\b∀*∞>J"B∩⊗Z≥"ε∞-KX4(&L1↓"∩-2NRε≤Yj∩⊗5Z⊃Fv|"⊗Z&≤)%v∩≤Xbaα$B⊗84PH$&
,:&9↓∧"⊗ZN$
∞-j%~.∞"uZ⊃Fvz"&:B≤Al4(HH$%∩LrB∞"z↓5↓EZα⊗:⊃Xh(&∩-2NRε≤Yi∩∞dr⊗n⊃
j⎇∩∞dr∃l4PJ∩⊗Z≥"ε∞-R"∞2&u∩n⊃Fmy∩∞2LrIl4PJ∩⊗Z≥"ε∞-R"∞J
|"fn⊃
j⎇∩∞∀∩>∩eXh(%∩≤b:⊗⎇$~2&:∃y∩∞J∀z∩f}u*21lhP&∩⊗5~Rε∞[R:⊗b%Z⊃Fv|"⊗ZN$
∞.R⎇↓l4(L"⊗ZN$
∞.R⎇α}⊃EXh*⊗:#X4(1¬β/CCπ;&kπ∂K{X4(4TJ:R⊗<*Iα∩,j6f∩cX4*B∀z∞⊗∩-∩∃α
$J:&QXh(&N-"
J⊗Y"∩Vljf∩2|:⊗R
∀*ε-2%*66dD"⊗2&jb:V2ba
&M∩Il4*∀*FV&∀)α
RLr&QαLr&R&b&jε$J>9lhP4*N%∩&:≥¬αJ>∞,"VJ∃∧*bBεt"BJ>~BJBR∩BNf6∀z1&M
Il4*∀*≡&8M∩BRIDjε∞JzIα6>#X4)↓α↓↓↓↓ααNRJLr≥αB
∩ε52≥∩
>∩Jb∞VJ∀z∩elhP&&:$*≡⊗I∧∩J∞"
⊃2∩2≤zV:QdrBεJil4(Hh(&N%∩&:≥¬~εY∩≤b:Nε3X4(&≤
Y∩∞drNεZz"∞2:≤
Z⊗m
αR=r↓5α2,r≡R!E">.⊗rJul4Ph(&:|*bBεt!α⎇α%∩V∃lhP&&→αB:Bε∀
6}6~J=juαεJεmZ6>R⎇~f6
|aj>
T*∞Rn≠
vu$Z↓@4(J↓↓↓α$B⊗9↓⊃↓C∂∪π7↔&+K↔⊃εkπ∂Kz⊂4($M~RJ&t9αεJ∀
eαε≥"BJ6≥YEj:∧
Jε6kYα&:$*≡⊗I∧Il4(HJNRJLr≥α∩,b&5lhP$&↑⎇∩⊂bJ,
⊃!	B⊃%l4Ph($&4zIα&{	αNR-↓↓Eα,rR&1∧rBεJh4($L"=↓∩↓∂?.sQβC∂∪π7↔&+KMλhP$%↓α↓αNR∀J:≥α%">.⊗sX4($J↓↓↓α=">.⊗sX4($J↓↓↓α%">.⊗uz:V2cX4($J↓↓↓αL1α⊗F*BR>.,q1λA∩H4($HJR"⊗r↓λ4PH$%↓α↓α∩2≤zV:Q¬y↓ElhP$$%α↓↓α∩zλ4(HH%↓↓αα∩⊗2Lj}J⊗"R&2bAλ@E∩Il4(HH%↓↓ααRR>\*:}R$z.⊗95">.⊗r2∩⊗2Lil4(HH%↓↓αα&→α$*2&5βi↓λA⊂h($$HJR"⊗rα∩2∞⎇*:Qαzα∩2∞⎇*:Q↓Z↓D4(HH$&⊗e~∃α∩d~>V:"α⎇α∩d~>V:"↓5↓EXh($$J↓↓↓~αV:RLaα∩2≤zV:Qk↓l4(HH%↓↓ααε∞R¬∩6NnMj}RR|Z⊗:m
αR=riFulhP$$%α↓↓α≡$z.⊗9\"⊗2&mzR>.,ql4(HH%↓↓α4(HI&⊗e~∃λhP$$%α↓↓αR$z.⊗:⎇">.⊗sX4($HI↓↓↓∧"⊗2&mzJ⊗ε%"&21B⊃1%	KX4($HI↓↓↓¬"R>.,r}RR|Z⊗9~$z.⊗9Xh($$J↓↓↓α~RBJm~n&v⎇"R>.,ql4(HH%↓↓α
l4PH$$$hP$%↓α↓α&→∧"⊗2&iY	1	∧
:⊃αKb:Bε∀
5αRD*84(HH&⊗J∀zI!
l
∞J=∧*bBεu~&>9Rβ∂?7n	β↔cε+∂S↔"β#↔K*⊃%l4PH%↓↓α
↓≡{W;QπβπKπn+S↔K~⊃l4(hP$&&2α∩⊗2Lhm	%⊂h($%α↓αR",qα⊗J∀zI!
l
∞J=∧*bBεu~&>9Rβ7'OnS∂#.!β;Wn∪↔Iβ}1βCπ⊗7↔S/∪M	%Xh($&≥∩
>∩Jα⎇α:,b1l4PI↓↓↓α↓↓↓α≥*J
>%Iα⎇αl
∞J=T∩>∩f\j>RuXh($&<B&2∃∧r>Qα-
U"∞-∩
>∩Jb:V2bH4($L"=λLJ:R⊗<*Iα%Xh($$L~J
>%J}∞J∀z∩e~≤~ε9"≥*J
>%I2∩Vljf∩1d∩J∞"
⊃%l4PH$&B
∩ε6}≤~ε9"≥*J
>%I2∩Vljf∩1d∩J∞"
⊃%l4PH$&~⎇⊃α&⎇
αNR⊗α↓EαVu"&1αl
∞J=TrBεJjn6>%iα∩<hP$$%α↓↓α&2α⊗FUEαεJεjb6ε∞∀yjBJdJNRnlzRvnMi%αRD*84(HH$$	¬αεJεmzε∞R¬∩6NnMin∩>t)m
Xh($$LJ→α%tjε∞J{R:Bε∀
6n6⎇"uαεt!α
J≤BεHmh($$HJR"⊗rα⊗JJ⎇⊃!
⊗Eαε:∩l
∞J=∧*JJ>∪Q↓⎇⎇{y	%lhP$$&≥∩
>∩Jα⎇α∞∀∩>∩eα1αBε∀
5l4PH$$
Xh($$~↓Cπ⊗7↔S/∪↔⊃βn∂K=⊂h(%↓α↓α⊗2≤)α∞J∀z∩eαzα6ε∞∀yj
>%Jn6>%il4(Lr>⊗b∧
:⊃αzα~ε2≤)l4(J"∞2:≤
Z⊗}≤
Y∩∞drNεYXh(&J-"VJ9D~J
>%I%l4T*:⊃lhP1¬βεKO∃Rβ;W7⊗+I3;.kM2≡$z.⊗9fsπ7↔6K3∃↓Xh(4(J	β∂#.≠/MβN1β;Wjβ'Mβ
β;W7⊗+Iβ?∩α↓l4Ph*N&mα2∃↓∧∩>>2,
9αB∀z∞⊗∩-∩∃α:,j
⊗IDJ:R⊗<*Iα:,i%l$hP&J⊗%*J9!α⊃Aλru*4q	J⊃α>I∧rV5u∀↓	%lhP4(%
β∂#↔≡[Mβ'2βS#∃π≠SK'v9β←?⊗!β∂?w#π';~↓β?;gIβ;Wn∪↔KMXh(4*≤J6B2*↓α
>|b⊗ε9¬αJ>∞,"VJ∃∧rV6ME~RJ&t9α↑>∀!%l$hP&
⊗<J8%
u→λ4(M~RJ&t9α↑]Zα&:R,:⊗Iα∃⊃l4(M:↑}N≤
9"↑⎇∩⊃1∩u*6Rε∩b
I%Xh(&&2α
IuTHEN RETURN (TRUE) ELSE RETURN (FALSE);
	END "NS";

	! returns true if the last TOKEN is a terminal character, CR or ;
INTERNAL SIMPLE  BOOLEAN PROCEDURE FINAL;
RETURN(TOKEN=SEMC OR TOKEN=CR OR TOKEN=NULL);


	! ignores input up to and including the next occurence of CHAR;
INTERNAL SIMPLE PROCEDURE READTO(STRING CHAR);
	BEGIN INTEGER I,BRCHAR; STRING R;
	SETBREAK(I←GETBREAK, CHAR, NULL, "IA");
	R←SSCAN($CLINR,I,BRCHAR);
	WHILE BRCHAR≠CHAR DO BEGIN NEWLINE; R←SCAN($CLINR,I,BRCHAR); END;
	RELBREAK(I);
	END;

	! returns in TOKEN the string upto but not including characters in CHARS:
	The break character is retained in the input string;
INTERNAL SIMPLE INTEGER PROCEDURE READTILL(STRING CHARS);
	BEGIN INTEGER I,BRCHAR; STRING R;
	SETBREAK(I←GETBREAK, CHARS, NULL, "IS");
	R←SSCAN($CLINR,I,BRCHAR);
	WHILE BRCHAR=NULL DO BEGIN NEWLINE; R←R&CRLF&SSCAN($CLINR,I,BRCHAR); END;
	RELBREAK(I); TOKEN←R;
	RETURN(BRCHAR);
	END;

INTERNAL RECURSIVE PROCEDURE GTOKEN (BOOLEAN MUSTGETTOKEN(TRUE));
	BEGIN "GTOKEN"
	STRING WORD,WORD2;
	INTEGER BRPARS; LABEL AGAIN; BOOLEAN NONSTOP;

	! reads next RTOKEN using the indicated breaktable;
	REQUIRE "<><>" DELIMITERS;
   define rtoken(aaa)=<scan($CLINR, aaa ,brpars)>;
   define rstoken(aaa)=<sscan($CLINR, aaa ,brpars)>;
	URSCHD;
	IF STOKEN THEN BEGIN STOKEN←FALSE;RETURN;END;
	tokenlevel←tokenclass←tokenindex←0;
	NONSTOP←MUSTGETTOKEN OR (DEVICE≠TTY_X AND DEVICE≠QUERY_X);
AGAIN: 	IF NONSTOP THEN WHILE $CLINR=NULL DO NEWLINE;
	WORD←NULL; #TOKEN←UNDECLARED_TYPE;
	RSTOKEN($SPCTAB);				! skips blanks;
	WORD←RSTOKEN($RETAB);	! word is either identifier or integer;
	IF WORD=NULL 
	    THEN IF BRPARS="." 
		THEN  BEGIN "period"		! no object read, period found;
			RSTOKEN($SKTAB);	! appends the . to the string saved ;
			RSTOKEN($ALFTAB);	! puts next character into brchr;
			IF NUMBER(BRPARS)
			THEN BEGIN "floating number"
				$CLINR←"."&$CLINR;
				$CLNSAVE←$CLNSAVE[1 TO ∞-1];
				WORD←SREALSCAN($CLINR,BRPARS); ! reads until finds numbers;
				#TOKEN  ←REAL_TYPE;	! floating number read;
				END "floating number"
			ELSE BEGIN "operator"
				WORD←".";
				#TOKEN  ←OPERATOR_TYPE;	! period is only a punctuation mark;
				END "operator";
			END "period"
		ELSE  IF (BRPARS=CR or BRPARS=NULL) AND NONSTOP
			THEN BEGIN "newline"
			NEWLINE;
			GO TO  AGAIN;
			END "newline"
		ELSE IF BRPARS="{"
			THEN BEGIN "comment found"
			! balance braces ;
			INTEGER I,BRACE_COUNT;
			BRACE_COUNT←0;	! brace is still on the input string ;
			DO IF (I←READTILL("{}"))="{"
				THEN BRACE_COUNT←BRACE_COUNT+1
				ELSE BRACE_COUNT←BRACE_COUNT-1
			   UNTIL BRACE_COUNT=0;
			GO TO AGAIN;
			END "comment found"
		ELSE IF BRPARS="⊗"
			THEN BEGIN "⊗"
			WORD←OLDOBJ;
			RSTOKEN($SKTAB);
			#TOKEN←ID_TYPE;
			END "⊗"
			ELSE BEGIN "operator"
				WORD←BRPARS;
				RSTOKEN($SKTAB);
				#TOKEN  ←OPERATOR_TYPE;		! punctuation mark found;
				END "operator"
	ELSE IF BRPARS="."  
		THEN IF NUMS(WORD) 
		        THEN BEGIN     "real number"
			$CLINR←WORD&$CLINR;
			$CLNSAVE←$CLNSAVE[1 TO  ∞ - LENGTH(WORD)];
			WORD←SREALSCAN($CLINR,BRPARS);
			#TOKEN  ←REAL_TYPE;	! floating number read;
			END "real number";
	TOKEN←WORD;
	! checks if RTOKEN is an integer number;

	IF TOKEN
	   THEN
	IF #TOKEN  =UNDECLARED_TYPE 
	    THEN BEGIN
	        IF NUMBER(WORD) 
	           THEN BEGIN				! if first ch. is a number;
			$CLNSAVE←$CLNSAVE[1 TO ∞-LENGTH(WORD)];
			$CLINR←WORD&$CLINR;
			TOKEN←SINTSCAN($CLINR,BRPARS);
			IF LENGTH(TOKEN)<LENGTH(WORD)
				THEN ERROR("SCANNER ERROR: "&WORD&" is an invalid identifier and number");
			#TOKEN←INT_TYPE;
	                END;
	        END;
	IF #TOKEN=UNDECLARED_TYPE
	   THEN IF DECSTR(TOKEN)≠0
		THEN #TOKEN←RES_TYPE
		ELSE begin "check for id"
			RPTR(SYMBOL)S; RPTR(BLOCKREC)BR;
			IF CURPROC THEN
			    IF EQU(TOKEN,SYMBOL:PNAME[CURPROC])
				THEN BEGIN #TOKEN←ID_TYPE;TOKENPTR←CURPROC;
				RETURN; END;
			BR←CURBLOCK;
			WHILE BR DO
			      BEGIN "check local variables"
			      S←SEARCHBLOCK(TOKEN,BR);
			      IF S THEN BEGIN #TOKEN←ID_TYPE;
				TOKENPTR←S; TOKENLEVEL←BLOCKREC:LEVEL[BR];
				TOKENINDEX←SYMBOL:TYPE[S]; RETURN; END;
			      BR←BLOCKREC:NEXT[BR];
			      END "check local variables";
			IF #TOKEN=UNDECLARED_TYPE THEN
			IF (TOKENPTR←CHECKTOT(TOKEN))≠NULL_RECORD
			THEN BEGIN #TOKEN←ID_TYPE; 
				IF (TOKENINDEX←SYMBOL:TYPE[TOKENPTR])=#MC
				    AND ¬NOEXPAND THEN
					BEGIN STRING SSS;
					SSS←EXPANDPROC(TOKENPTR);
					PUSHDEVSTACK;
					$CRBODY←SSS;
					DEVICE←MAC_X;
					GTOKEN;
					END;
			    END;
			end "check for id";
	END "GTOKEN";
	! reads a file name and returns it ;

INTERNAL STRING PROCEDURE NAMEFILE;
	BEGIN "NAMEFILE"
	STRING NAME;
	GTOKEN; 

	NAME←TOKEN;				! name of file;
	GTOKEN(FALSE);
	IF #TOKEN =REAL_TYPE
	    THEN IF TOKEN="."
		THEN BEGIN NAME←NAME&TOKEN; GTOKEN(FALSE); END
		ELSE ERROR("Identifier required")
	    ELSE IF EQU(TOKEN,".")
		THEN BEGIN "EXT"			! extension;
		    GTOKEN; NAME←NAME&"."&TOKEN; GTOKEN(FALSE);
		    END "EXT";

	IF TOKEN="["
	    THEN BEGIN "PPN"		! there is ppn;
		GTOKEN;			
		NAME←NAME&"["&TOKEN; GTOKEN(FALSE);
		IF TOKEN=","
		    THEN BEGIN "PN"
			GTOKEN(FALSE);		! there is pn;
			IF TOKEN=NULL THEN RETURN(NAME);
			NAME←NAME&","&TOKEN;
			GTOKEN(FALSE);
			IF TOKEN="]" OR TOKEN=NULL THEN NAME←NAME&"]"
			    ELSE ERROR("] required");
			END "PN"
		ELSE IF TOKEN=NULL
		    THEN RETURN(NAME)
		    ELSE ERROR("comma required");
		END "PPN"
	    ELSE STOKEN←TRUE;
	RETURN(NAME);
	END "NAMEFILE";
!	_read procedures;

INTERNAL INTEGER PROCEDURE POSINT_READ;
	BEGIN
	! reads a positive integer and returns it as a number;
	INTEGER TEMP,I; STRING TEMPS;
	GTOKEN;
	IF #TOKEN≠INT_TYPE THEN ERROR("positive integer expected");
	TEMPS←TOKEN;
	TEMP←INTSCAN(TEMPS,I);
	IF TEMP<0 THEN ERROR("non negative integer expected");
	return (TEMP);
	END;

INTERNAL SIMPLE  PROCEDURE SEMICOL_READ;
	BEGIN
	GTOKEN(FALSE);
	IF NOT FINAL THEN ERROR("Need ; or carriage return here");
	END;

INTERNAL SIMPLE  PROCEDURE WORD_READ(STRING S);
	BEGIN
	GTOKEN;
	IF NOT EQU(TOKEN,S) THEN ERROR("----→ "&S&" required ←-----");
	END;


INTERNAL SIMPLE  STRING PROCEDURE IDF_READ;
	BEGIN
	GTOKEN;
	IF #TOKEN  =INT_TYPE OR #TOKEN=REAL_TYPE OR #TOKEN=OPERATOR_TYPE
	    THEN ERROR("identifier required")
	    ELSE RETURN(TOKEN);
	END;

INTERNAL SIMPLE STRING PROCEDURE MVFR_READ;
	BEGIN
 	GTOKEN;
	IF EQU(TOKEN,"BY") 
	   THEN BEGIN STOKEN←TRUE; RETURN("BARM"); END
	   ELSE IF #TOKEN=ID_TYPE
		THEN RETURN(TOKEN)
		ELSE ERROR("identifier required");
	END;
		
INTERNAL SIMPLE  STRING PROCEDURE HAND_READ;
	BEGIN				! reads BHAND or YHAND (default= BHAND);
	GTOKEN;
	IF EQU(TOKEN,"BHAND") OR EQU(TOKEN,"YHAND") 
	   THEN RETURN(TOKEN)
	   ELSE IF EQU(TOKEN,"TO") OR EQU(TOKEN,"BY")
		THEN BEGIN STOKEN←TRUE; RETURN("BHAND"); END
		ELSE ERROR("a hand required here");
	END;

INTERNAL SIMPLE  STRING PROCEDURE ARM_READ;
	BEGIN		! reads "BARM" or "YARM" (default=BARM);
	GTOKEN(FALSE);
	IF EQU(TOKEN,"YARM") OR EQU(TOKEN,"BARM") 
	   THEN RETURN(TOKEN)
	   ELSE IF TOKEN=";" OR FINAL
		THEN BEGIN STOKEN←TRUE; RETURN("BARM"); END
		ELSE ERROR(" arm required here");
	END;

ifc false thenc
INTERNAL SIMPLE STRING PROCEDURE DEV_READ;
	BEGIN		! reads BARM/YARM/POINTER (default=POINTER);
	GTOKEN(FALSE);
	IF EQU(TOKEN,"POINTER") OR EQU(TOKEN,"BARM") OR EQU(TOKEN,"YARM")
	   THEN RETURN(TOKEN)
	   ELSE IF FINAL OR TOKEN=";" THEN
	   	BEGIN STOKEN←TRUE; RETURN("POINTER") END
		ELSE ERROR(" arm or POINTER or ; required",CRLF);
	END;

	! returns the FROM frame  "{FROM <frame>}" or STATION;
INTERNAL SIMPLE	STRING PROCEDURE FROMPART;
	BEGIN
	STRING ROOT;
        GTOKEN(FALSE);
	IF EQU(TOKEN,"FROM")
	   THEN BEGIN ROOT←IDF_READ; RETURN(ROOT); END
	   ELSE	IF FINAL 
		THEN RETURN("STATION")
		ELSE ERROR("; or FROM required");
	END;
endc
! input from different sources ;
INTERNAL PROCEDURE ASKUSER(STRING S(NULL));
BEGIN
	PUSHDEVSTACK;
	IF S=NULL 
	    THEN BEGIN $CLNE←$CLINR←INCHWL; DEVICE←QUERY_X; END
	    ELSE BEGIN $CLNE←$CLINR←NULL; $CRBODY←S; DEVICE←PROGRAM_X; END;
END;

INTEGER $CVRTBREAK;
PROCEDURE INITCVRT;
	SETBREAK($CVRTBREAK←GETBREAK,NULL,NULL,"K");
REQUIRE INITCVRT INITIALIZATION;

STRING PROCEDURE LISPMESS;
BEGIN
DEFINE MAIL = "710000000000";
STRING STR;INTEGER I;
INTEGER ARRAY MESS[1:32];
  STR←NULL;
  DO BEGIN
    START_CODE
      MAIL 1,ACCESS(MESS[1]);
    END;
    FOR I←1 STEP 1 UNTIL 31 DO STR←STR&CVASTR(MESS[I]);
    END UNTIL MESS[32]=0;
  RETURN(SCAN(STR,$CVRTBREAK,I));
END;

INTEGER TTYLINES;

INTERNAL PROCEDURE NEWLINE;
BEGIN
	CHKESC_I;
	$CLNSAVE←$CLNSAVE&CRLF;
	CASE DEVICE OF
	BEGIN
	[QUERY_X] [MAC_X] [PROGRAM_X]
		BEGIN
		INTEGER BRCHAR;
		IF $CRBODY THEN $CLNE←$CLINR←SCAN($CRBODY,$CRTAB,BRCHAR)
			ELSE POPDEVSTACK;
		END;
		
	[TTY_X]	BEGIN
		INTEGER INCHSL_FLAG;
		$CLNE←$CLINR←INCHSL(INCHSL_FLAG);
		IF INCHSL_FLAG THEN
			BEGIN ! no type ahead, better update;
			IF NOT $UPDATED THEN RENEW;
			IF STBEGIN THEN OUTSTR("* ") ELSE OUTSTR("***>>> ");
			WHILE INCHSL_FLAG DO
				BEGIN URSCHD; CALL(0,"SLEEP");
					$CLNE←$CLINR←INCHSL(INCHSL_FLAG) END
			END
		ELSE IF STBEGIN THEN OUTSTR("* ")
		ELSE OUTSTR("***>>> ");
		IF $SYSOUT THEN CPRINT($SYSCH,$CLNE,CRLF);
		IF $OUT THEN CPRINT($TTYCH,$CLNE,CRLF);
		IF TTYLINES≥6 THEN 
			BEGIN IF $OUT THEN UDATEFILE($TTYCH);
			      IF $SYSOUT THEN UDATEFILE($SYSCH);
			      TTYLINES←0; END
		    ELSE TTYLINES←TTYLINES+1;
		END;

	[DSK_X]	IF $EOF
		THEN	BEGIN $ALLOW←0; RELEASE($INPCH);
			POPDEVSTACK; UPDATE;
			END
		ELSE 	BEGIN
			$CLNE←$CLINR←INPUT($INPCH,$CRTAB);
			IF NEWFILE THEN
				BEGIN IF $CLNE[1 TO 17] =
					"COMMENT ⊗   VALID"
					THEN $CLNE←INPUT($INPCH,$FFTAB);
					$CLNE←$CLINR←INPUT($INPCH,$CRTAB);
					NEWFILE←FALSE;
				END;
			IF FILEPRINT THEN PRINT(CRLF,$CLNE);
			END;

	[MESSAGE_X]
		BEGIN
		OUTSTR("WAITING FOR MAIL... ");
		$CLNE←$CLINR←LISPMESS;
		OUTSTR("MAIL RECEIVED: "&$clne&crlf);
		IF $OUT THEN BEGIN CPRINT($TTYCH,"{mail received}",$CLNE,CRLF);
		IF TTYLINES≥6 THEN BEGIN UDATEFILE($TTYCH); TTYLINES←0; END
			ELSE TTYLINES←TTYLINES+1;
			    END;
		END;

	ELSE	BEGIN MTYDEVSTACK; ERROR("NO SUCH DEVICE"); END
	END;
END;
END "SCANNER";